home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / itcl1_31.z / itcl1_31 / tcldev / itcl-1.3 / tests / upvar.test < prev    next >
Encoding:
Text File  |  1993-09-23  |  2.7 KB  |  107 lines
  1. #
  2. # Tests for "upvar" across interpreter boundaries
  3. # ----------------------------------------------------------------------
  4. #   AUTHOR:  Michael J. McLennan       Phone: (215)770-2842
  5. #            AT&T Bell Laboratories   E-mail: aluxpo!mmc@att.com
  6. #
  7. #     SCCS:  @(#)upvar.test    1.1 (9/9/93)
  8. # ----------------------------------------------------------------------
  9. #            Copyright (c) 1993  AT&T  All Rights Reserved
  10. # ======================================================================
  11.  
  12. # ----------------------------------------------------------------------
  13. #  DEFINE SOME USEFUL ROUTINES
  14. # ----------------------------------------------------------------------
  15. proc upvarTest_show_var {var val} {
  16.     return "$var>>$val"
  17. }
  18.  
  19. proc upvarTest_upvar_in_procs {} {
  20.     set upvarTest_var_local "value in main interp"
  21.     foo do {
  22.         upvar upvarTest_var_local var
  23.         set var
  24.     }
  25. }
  26.  
  27. # ----------------------------------------------------------------------
  28. #  CREATE SOME OBJECTS
  29. # ----------------------------------------------------------------------
  30. Foo foo
  31. Baz baz
  32.  
  33. # ----------------------------------------------------------------------
  34. #  UPVAR TESTS
  35. # ----------------------------------------------------------------------
  36. test {"::" sends command to global interp but preserves
  37. local variables.  This ensures that when control
  38. shifts to the global scope for Extended Tcl commands,
  39. Expect commands, etc., local variables will be
  40. recognized.} {
  41.     foo do {
  42.         set localvar "special"
  43.         ::eval {upvarTest_show_var localvar $localvar}
  44.     }
  45. } {
  46.     $result == "Foo says 'localvar>>special'"
  47. }
  48.  
  49.  
  50. test {"upvar" can cross interp boundaries to access local variables} {
  51.     upvarTest_upvar_in_procs
  52. } {
  53.     $result == "Foo says 'value in main interp'"
  54. }
  55.  
  56. test {"upvar" can cross interp boundaries to access global variables} {
  57.     set upvarTest_var_global "value in main interp"
  58.     foo do {
  59.         upvar upvarTest_var_global var
  60.         set var
  61.     }
  62. } {
  63.     $result == "Foo says 'value in main interp'"
  64. }
  65.  
  66. test {"upvar" can handle multiple call frames on the stack} {
  67.     set upvarTest_var_global "new value"
  68.     foo do {
  69.         foo do {
  70.             upvar #0 upvarTest_var_global var
  71.             set var
  72.         }
  73.     }
  74. } {
  75.     $result == "Foo says 'Foo says 'new value''"
  76. }
  77.  
  78. test {"upvar" can cross class interp boundaries} {
  79.     baz do {
  80.         set localvar "value in Baz"
  81.         foo do {
  82.             upvar localvar var
  83.             set var
  84.         }
  85.     }
  86. } {
  87.     $result == "Baz says 'Foo says 'value in Baz''"
  88. }
  89.  
  90. test {"upvar" can cross class interp boundaries back to main interp} {
  91.     set upvarTest_var_global "global value"
  92.     baz do {
  93.         foo do {
  94.             upvar 2 upvarTest_var_global var
  95.             set var
  96.         }
  97.     }
  98. } {
  99.     $result == "Baz says 'Foo says 'global value''"
  100. }
  101.  
  102. # ----------------------------------------------------------------------
  103. #  CLEAN UP
  104. # ----------------------------------------------------------------------
  105. foo delete
  106. baz delete
  107.